home *** CD-ROM | disk | FTP | other *** search
/ Shareware Grab Bag / Shareware Grab Bag.iso / 090 / pctjoc85.arc / FILECOPY.F77 < prev    next >
Text File  |  1985-03-24  |  2KB  |  88 lines
  1.       program filecopy
  2.  
  3.       integer*4   n
  4.       integer*4   buffer (256)
  5.       integer*4   words, iter, bytes
  6.  
  7.       write  (*, 1)
  8. 1     format (' iterations, record length: ' )
  9.       read   (*, *) iter, bytes
  10.  
  11.       do 10 n = 1, 256
  12. 10       buffer (n) = n
  13.  
  14.       words = bytes/4
  15.       call make file ('A:FILE.IN',  buffer, words)
  16.       call make file ('A:FILE.OUT', buffer, words)
  17.       call doit (buffer, words, iter)
  18.       stop
  19.       end
  20.       subroutine doit (buffer, size, iter)
  21.       integer*4        size, buffer (size), iter
  22.  
  23.       integer*4   i, in, out
  24.       integer*4   n
  25.       integer*4   bytes, records
  26.       integer*4   recnr, ioerr
  27.       integer*2   e (4), s (4)
  28.  
  29.       bytes = size*4
  30.       records = 32768 / bytes
  31.       in  = 1
  32.       out = 2
  33.  
  34.       call time (s)
  35.       do 50 i = 1, iter
  36.          open (in, file = 'A:FILE.IN',
  37.      1         access = 'DIRECT', recl = bytes,
  38.      1         status = 'OLD', form = 'UNFORMATTED')
  39.          open (out, file = 'A:FILE.OUT',
  40.      1         access = 'DIRECT', recl = bytes,
  41.      1         status = 'OLD', form = 'UNFORMATTED')
  42.    
  43.          n = 0
  44.          do 30 recnr = 1, records
  45.             read (in, rec = recnr) buffer
  46.             write (out, rec = recnr) buffer
  47.             n = n + bytes
  48. 30       continue
  49.  
  50. 40       close (in)
  51.          close (out)
  52. 50       continue
  53.       write (*, 60) recnr - 1, n
  54. 60    format (' done - ', I6, ' records ', I6, ' bytes')
  55.       call etime (e, s, iter)
  56.       return
  57.  
  58. 100   write (*, 101) ioerr, recnr, n
  59. 101   format (' *** read error ', 3I6, ' ***')
  60.       stop
  61.  
  62. 200   write (*, 201) n, i, bytes
  63. 201   format ('*** write error record', I6, ' of', I6, I6, ' bytes')
  64.       stop
  65.       end
  66.       subroutine make file (file, buffer, size)
  67.       character*(*)         file
  68.       integer*4             size, buffer (size)
  69.  
  70.       integer*4   records, out
  71.       integer*4   n, io status
  72.       integer*4   bytes
  73.  
  74.       bytes = size*4
  75.       out = 2
  76.       open (out, file = file, status = 'NEW',
  77.      1      access = 'DIRECT', recl = bytes,
  78.      1      form = 'UNFORMATTED')
  79.  
  80.       records = 32768 / bytes
  81.       write (*, 15)records, bytes
  82. 15    format (' ', I8, ' records of ', I4, ' bytes')
  83.       do 20 n = 1, records
  84. 20       write (out, rec = n) buffer
  85.       close (out)
  86.       return
  87.       end
  88.